perm filename EPUTS3.2[EAL,HE]2 blob
sn#701215 filedate 1983-03-24 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 {$NOMAIN Editor: Statement printing routine Aux routines }
C00024 00003 { Externally defined routines from elsewhere: }
C00026 00004 (* putStmnt aux routine to handle the other half of the statement types *)
C00037 ENDMK
C⊗;
{$NOMAIN Editor: Statement printing routine Aux routines }
const
(* Constants from EDIT *)
maxLines = 28; (* smaller on the 11 than on the 10 *)
maxPPLines = 18;
maxBpts = 25;
maxTBpts = 20; (* max could be exceeded by huge case stmnt *)
listinglength = 2000; (* Length of Listingarray *)
(* Random type declarations for OMSI/SAIL compatibility *)
type
byte = 0..255; (* doesn't really belong here, but... *)
ascii = char;
atext = text;
{ Define all the pointer types here }
strngp = ↑strng;
statementp = ↑statement;
varidefp = ↑varidef;
tokenp = ↑token;
nodep = ↑node;
identp = ↑ident;
reswordp = ↑resword;
pdbp = ↑pdb;
envheaderp = ↑envheader;
enventryp = ↑enventry;
environp = ↑environment;
cmoncbp = ↑cmoncb;
linerecp = ↑linerec;
cursorpp = ↑cursorp; {Ron's style, not mine}
(* This one is used whenever a pointer is needed for which the *)
(* definition is missing from this file; naturally, all *)
(* pointers use the same space *)
dump = ↑integer;
(* datatype definitions *)
datatypes = (pconstype, varitype, svaltype, vectype, rottype, transtype,
frametype, eventtype, strngtype, labeltype, proctype, arraytype,
reftype, valtype, cmontype, nulltype, undeftype,
dimensiontype, mactype, macargtype, freevartype);
scalar = real;
cstring = packed array [1..10] of ascii;
c4str = packed array [1..4] of ascii;
c5str = packed array [1..5] of ascii;
c20str = packed array [1..20] of ascii;
linestr = packed array [1..130] of ascii;
strng = record
next: strngp;
ch: cstring;
end;
(* statement definitions *)
stmntypes = (progtype, blocktype, coblocktype, endtype, coendtype,
fortype, iftype, whiletype, untiltype, casetype,
calltype, returntype,
printtype, prompttype, pausetype, aborttype, assigntype,
signaltype, waittype, enabletype, disabletype, cmtype,
affixtype, unfixtype,
movetype, operatetype, opentype, closetype, centertype,
stoptype, retrytype,
requiretype, definetype, macrotype, commenttype, dimdeftype,
setbasetype, wristtype, tovaltype, declaretype, emptytype);
(* more??? *)
statement = packed record
next, last: statementp; (* ↑ to lexical tokens? *)
stlab: varidefp;
exprs: nodep; (* any expressions used by this statement *)
nlines: integer;
bpt: boolean;
case stype: stmntypes of
untiltype: (cond: nodep; body: statementp);
casetype: (index: nodep; range, ncases: integer; caselist: nodep);
returntype: (retval, rproc: nodep);
calltype,
assigntype: (what, aval: nodep);
pausetype: (ptime: nodep);
prompttype,
printtype,
aborttype: (plist: nodep; debugLev: integer);
signaltype,
waittype: (event: nodep);
enabletype,
disabletype: (cmonlab: varidefp);
affixtype,
unfixtype: (frame1, frame2, byvar, atexp: nodep; rigid: boolean);
stoptype: (cf, clauses: nodep);
retrytype: (rcode, rparent: statementp; olevel: integer);
requiretype: (rfil: boolean; rfils: strngp; rfilen: integer);
definetype: (macname,mpars: varidefp; macdef: tokenp);
commenttype: (len: integer; str: strngp; cbody: statementp);
dimdeftype: (dimname: varidefp; dimexpr: nodep);
setbasetype,
wristtype: (fvec, tvec: nodep);
end;
(* auxiliary definitions: variable, etc. *)
varidef = packed record
next,dnext: varidefp;
name: identp;
level: 0..255; (* environment level *)
offset: 0..255; (* environment offset *)
dtype: varidefp; (* to hold the dimension info *)
tbits: 0..15; (* special type bits: array = 1, proc = 2, ref = 4 & ? *)
dbits: 0..15; (* for use by debugger/interpreter *)
case vtype: datatypes of
arraytype: (a: nodep);
proctype: (p: nodep);
labeltype,
cmontype: (s: statementp);
mactype: (mdef: statementp);
macargtype: (marg: tokenp);
pconstype: (c: nodep);
dimensiontype: (dim: nodep);
end;
(* definition of the ubiquitous NODE record *)
nodetypes = (exprnode, leafnode, listnode, clistnode, colistnode, forvalnode,
deprnode, viaptnode, apprnode, destnode, durnode,
sfacnode, wobblenode, swtnode, nullingnode, wristnode, cwnode,
arrivalnode, departingnode,
ffnode, forcenode, stiffnode, gathernode, cmonnode, errornode,
calcnode, arraydefnode, bnddefnode, bndvalnode,
waitlistnode, procdefnode, tlistnode, dimnode, commentnode);
exprtypes = ( svalop, (* scalar operators *)
sltop, sleop, seqop, sgeop, sgtop, sneop, (* relations *)
notop, orop, xorop, andop, eqvop, (* logical *)
saddop, ssubop, smulop, sdivop, snegop, sabsop, (* scalar ops *)
sexpop, maxop, minop, intop, idivop, modop,
sqrtop, logop, expop, timeop, (* functions *)
sinop, cosop, tanop, asinop, acosop, atan2op, (* trig *)
vdotop, vmagnop, tmagnop,
vecop, (* vector operators *)
vmakeop, unitvop, vaddop, vsubop, crossvop, vnegop,
svmulop, vsmulop, vsdivop, tvmulop, wrtop,
tposop, taxisop,
transop, (* trans operators *)
tmakeop, torientop, ttmulop, tvaddop, tvsubop, tinvrtop,
vsaxwrop, constrop, ftofop, deproachop, fmakeop, vmkfrcop,
ioop, (* i/o operators *)
queryop, inscalarop,
specop, (* special operators *)
arefop, callop, grinchop, macroop, vmop, adcop, dacop,
badop,
addop, subop, negop, mulop, divop, absop); (* for parsing *)
leaftypes = pconstype..strngtype;
reltypes = sltop..sgtop;
forcetypes = (force,absforce,torque,abstorque,angvelocity);
node = record
next: nodep;
case ntype: nodetypes of
exprnode: (op: exprtypes; arg1, arg2, arg3: nodep; elength: integer);
leafnode: (case ltype: leaftypes of
varitype: (vari: varidefp; vid: identp);
pconstype: (cname: varidefp; pcval: nodep);
svaltype: (s: scalar; wid: integer);
vectype: (v: dump);
transtype: (t: dump);
strngtype: (length: integer; str: strngp) ); (* also used by commentnodes *)
errornode: (eexpr: nodep);
listnode: (lval: nodep);
clistnode: (cval: integer; stmnt: statementp; clast: nodep);
colistnode: (prev: nodep; cstmnt: statementp);
end;
(* records for parser: ident, token, resword *)
ident = record
next: identp;
length: integer;
name: strngp;
predefined: varidefp;
end;
tokentypes = (reswdtype, identtype, constype, comnttype, delimtype, labeldeftype,
macpartype);
constypes = svaltype..strngtype;
reswdtypes = (stmnttype, filtype, clsetype, decltype, optype, edittype);
filtypes = (abouttype,alongtype,attype,bytype,defertype,dotype,elsetype,
errmodestype,fromtype,handtype,intype,nonrigidlytype,rigidlytype,
sourcefiletype,steptype,thentype,totype,untltype,viatype,
withtype,worldtype,zeroedtype,oftype,wheretype,nowaittype,
ontype,offtype,ppsizetype,collecttype,alltype,lextype);
clsetypes = (approachtype,arrivaltype,departuretype,departingtype,durationtype,
errortype,forcetype,forceframetype,forcewristtype,gathertype,
nildeproachtype,nonullingtype,nullingtype,stiffnesstype,
torquetype,velocitytype,wobbletype,
cwtype,ccwtype,stopwaittimetype,angularvelocitytype,
fxtype,fytype,fztype,mxtype,mytype,mztype,
t1type,t2type,t3type,t4type,t5type,t6type,tbltype);
edittypes = (getcmd,savecmd,insertcmd,renamecmd,startcmd,gocmd,proceedcmd,
stepcmd,sstepcmd,nstepcmd,gstepcmd,executecmd,setcmd,tracecmd,
breakcmd,unbreakcmd,tbreakcmd,definecmd,markcmd,unmarkcmd,
popcmd);
token = record
next: tokenp;
case ttype: tokentypes of
constype: (cons: nodep);
comnttype: (len: integer; str: strngp);
delimtype: (ch: ascii);
reswdtype: (case rtype: reswdtypes of
stmnttype: (stmnt: stmntypes);
filtype: (filler: filtypes);
clsetype: (clause: clsetypes);
decltype: (decl: datatypes);
optype: (op: exprtypes);
edittype: (ed: edittypes) );
identtype: (id: identp);
labeldeftype: (lab: varidefp);
macpartype: (mpar: varidefp);
end;
resword = record
next: reswordp;
length: integer;
name: strngp;
case rtype: reswdtypes of
stmnttype: (stmnt: stmntypes);
filtype: (filler: filtypes);
clsetype: (clause: clsetypes);
decltype: (decl: datatypes);
optype: (op: exprtypes);
edittype: (ed: edittypes);
end;
(* process descriptor blocks & environment record definitions *)
queuetypes = (nullqueue,nowrunning,runqueue,inputqueue,eventqueue,sleepqueue,
forcewait,devicewait,joinwait,proccall);
pdb = packed record
nextpdb,next: pdbp; (* for list of all/active pdb's *)
level: 0..255; (* lexical level *)
mode: 0..255; (* expression/statement/sub-statement *)
priority: 0..255;
status: queuetypes; (* what are we doing *)
env: envheaderp;
spc: statementp; (* current statement *)
epc: nodep; (* current expression (if any) *)
sp: nodep; (* intermediate value stack *)
cm: cmoncbp; (* if we're a cmon point to our definition *)
mech: dump; (* current device being used *)
linenum: integer; (* used by editor/debugger *)
case procp: boolean of (* true if we're a procedure *)
true: (opdb: pdbp; (* pdb to restore when procedure exits *)
pdef: nodep); (* procedure definition node *)
false: (evt: dump; (* event to signal when process goes away *)
sdef: statementp); (* first statement where process was defined *)
end;
envheader = packed record
parent: envheaderp;
env: array [0..4] of environp;
varcnt: 0..255; (* # of variables in use ??? *)
case procp: boolean of (* true if we're a procedure *)
true: (proc: nodep);
false:(block: statementp);
end;
enventry = record
case etype: datatypes of
svaltype: (s: scalar);
vectype: (v: dump);
transtype: (t: dump);
frametype: (f: dump);
eventtype: (evt: dump);
strngtype: (length: integer; str: strngp);
cmontype: (c: cmoncbp);
proctype: (p: nodep; penv: envheaderp);
reftype: (r: enventryp);
arraytype: (a: envheaderp; bnds: nodep);
end;
environment = record
next: environp;
vals: array [0..9] of enventryp;
end;
cmoncb = record
running, enabled: boolean; (* cmon's status *)
cmon: statementp;
pdb: pdbp;
evt: dump;
fbits: integer; (* bits for force sensing *)
oldcmon: cmoncbp; (* for debugger *)
end;
(* print related records: *)
cursorp = record
cline,ind: integer;
case stmntp: boolean of
true: (st: statementp);
false: (nd: nodep);
end;
linerec = record
next: linerecp;
start,length: integer
end;
listingarray = packed array [0..listinglength] of ascii;
(* Global variables *)
var
(* From ALMAIN *)
b:boolean;
ch:ascii;
ltime: real;
(* From PARSE *)
reswords: array [0..26] of reswordp;
idents: array [0..26] of identp;
macrostack: array [1..10] of tokenp;
curmacstack: array [1..10] of varidefp;
macrodepth: integer;
curchar, maxchar, curline: integer;
curBlock,newDeclarations: statementp;
curProc: varidefp;
pnode: nodep;
nodim, distancedim, timedim, angledim,
forcedim, torquedim, veldim, angveldim: varidefp;
fvstiffdim, mvstiffdim: nodep;
(* filedepth: integer;
curpage: integer;
sysVars,unVars: varidefp;
errcount: integer;
outerBlock: statementp;
curVariable: varidefp;
curMotion: statementp;
endOk,coendOk: integer;
moveLevel: integer;
curErrhandler, curCmon: statementp; *)
d1: array[1..13] of dump;
endOfLine, backup, expandmacros, flushcomments, dimCheck: boolean;
(* semiseen, shownline: boolean;
eofError: boolean;
inMove,inCoblock: boolean; *)
d2,d3,d4,d5,d6: boolean;
curtoken: token;
file1,file2,file3,file4,file5: atext;
line: linestr;
(* From INTERP *)
curInt, activeInts, readQueue, allPdbs: pdbp;
(* curEnv, sysEnv: envheaderp;
clkQueue: nodep;
allEvents: dump;
STLevel: integer;
etime: integer;
curtime: integer;
stime: integer;
msg: dump;
inputp: integer; *)
d10: array[1..10] of integer;
debugLevel: integer;
tSingleThreadMode: boolean;
resched, running, escapeI, singleThreadMode: boolean;
msgp: boolean; (* flag set if any messages pending *)
inputReady: boolean;
inputLine: array [1..20] of ascii;
(* From EDIT *)
lines: array [1..maxLines] of linerecp;
ppLines: array [1..maxPPLines] of linerecp;
marks: array [1..20] of integer;
cursorStack: array [1..15] of cursorp;
bpts: array [1..maxBpts] of statementp;
tbpts: array [1..maxTBpts] of statementp;
debugPdbs: array [0..10] of pdbp;
screenheight,dispHeight: integer;
ppBufp,oppBufp,ppOffset,ppSize,nmarks: integer;
lbufp,cursor,ocur,cursorLine,fieldnum,lineNum,findLine,pcLine: integer;
firstDline,topDline,botDline,firstLine,lastLine: integer;
freeLines,oldLines: linerecp;
findStmnt: statementp;
nbpts,ntbpts: integer;
eCurInt: pdbp;
dProg: statementp;
smartTerminal: boolean;
setUp,setExpr,setCursor,dontPrint,outFilep,newVarOk,collect: boolean;
backUp: boolean;
eSingleThreadMode: boolean;
listing: listingarray;
lbuf: array [1..160] of ascii;
ppBuf: array [1..100] of ascii;
outFile: atext;
curToken: token;
(* Various device & variable pointers *)
speedfactor: enventryp;
barm: dump;
(* Various constant pointers *)
xhat,yhat,zhat,nilvect: dump;
niltrans: dump;
bpark, ypark, gpark, rpark: dump; (* arm park positions *)
{ Externally defined routines from elsewhere: }
(* From EAUX1A *)
procedure pushStmnt(s: statementp; indent: integer); external;
procedure pushNode(n: nodep); external;
(* From EPUT *)
procedure putChar(ch: ascii); external;
procedure put5(ch: c5str; length: integer); external;
procedure put10(ch: cstring; length: integer); external;
procedure putLine; external;
procedure putReal(s: real); external;
procedure putInt(r: real); external;
procedure putStrng(length: integer; s: strngp); external;
procedure putTlist(t: tokenp); external;
function getExprLength(n: nodep): integer; external;
(* From EPUTST *)
procedure putexpr(n: nodep; opp: integer); external;
procedure newline(indent: integer); external;
procedure outExpr(n: nodep); external;
(* From EROOT *)
procedure ep3putstmnt(s: statementp; indent, plevel: integer); external;
procedure ePs3Get; external;
procedure ePs3Get; begin end;
(* putStmnt aux routine to handle the other half of the statement types *)
procedure putst3(s: statementp; indent, plevel: integer; var l: integer); external;
procedure putst3;
var i,j,k: integer; n: nodep; v: varidefp; t: tokenp; b: boolean;
begin
with s↑ do
case stype of
untiltype: begin
put5('do ',2);
ep3PutStmnt(body,indent+2,plevel);
newline(indent);
if setCursor and (cursorLine = curLine) then fieldNum := 2;
put10('until ',6);
outExpr(cond);
end;
casetype: begin
put5('case ',5);
outExpr(index);
put5(' of ',3);
newline(indent+1);
put5('begin',5);
j := indent + 2;
if setCursor and (cursorLine = curLine) then fieldNum := 2;
n := caselist;
if range >= 0 then (* unlabelled case stmnt *)
begin
if n <> nil then k := n↑.cval else k := range+1;
for i := 0 to range do
begin
if i >= k then
begin
if setCursor then
if (curLine < cursorLine) and
(cursorLine <= curLine + n↑.stmnt↑.nlines) then
pushNode(n);
ep3PutStmnt(n↑.stmnt,j,plevel);
n := n↑.next;
if n <> nil then k := n↑.cval else k := range + 1;
end;
if i <> range then putchar(';')
end
end
else
while n <> nil do (* labelled case stmnt *)
begin
if setCursor then
if (curLine < cursorLine) and
(cursorLine <= curLine + n↑.stmnt↑.nlines + 1) then
begin
with cursorStack[cursor] do
if (not stmntp) and (nd↑.ntype = clistnode) then
cursor := cursor - 1; (* if multiple labels *)
pushNode(n);
end;
newline(indent);
if n↑.cval = -1 then put5('else ',4)
else if n↑.cval = -2 then put5('[??] ',4)
else
begin putchar('['); putint(n↑.cval); putchar(']') end;
b := n↑.next <> nil; (* check for multiple labels *)
if b then b := n↑.stmnt = n↑.next↑.stmnt;
if not b then
begin
ep3PutStmnt(n↑.stmnt,j,plevel);
if n↑.next <> nil then putchar(';')
end;
n := n↑.next;
end;
ep3PutStmnt(caselist↑.stmnt↑.next,indent+1,2);
end;
calltype: begin
outExpr(what);
end;
returntype: begin
put10('return ',6);
if retval <> nil then
begin
putchar('(');
outExpr(retval);
putchar(')');
end;
end;
pausetype: begin
put10('pause ',6);
outExpr(ptime);
end;
printtype,
prompttype,
aborttype,
saytype: begin
if stype = printtype then put5('print',5)
else if stype = prompttype then put10('prompt ',6)
else if stype = aborttype then put5('abort',5)
else put5('say ',3);
n := plist;
if n <> nil then
begin
putchar('(');
if setup then
begin
outExpr(n↑.lval); (* see how long first is *)
i := lbufp + 1;
n := n↑.next;
while n <> nil do
begin
lbufp := 1; (* so we don't overflow line buffer *)
outExpr(n↑.lval); (* see how long next is *)
if i + lbufp > 78 then (* will it fit on same line? *)
begin (* no - display it on next line *)
curline := curline + 1;
i := indent + 7 + getExprLength(n↑.lval);
end
else i := i + lbufp + 1; (* length of line so far *)
n := n↑.next;
end;
end
else
begin
i := 1;
outExpr(n↑.lval);
n := n↑.next;
while n <> nil do
begin
putchar(',');
i := i + 1;
if lbufp + getExprLength(n↑.lval) > 78 then
begin (* display it on next line *)
newline(indent+6);
if setCursor and (curLine = cursorLine) then
fieldNum := i;
end;
outExpr(n↑.lval);
n := n↑.next;
end;
putchar(')');
end;
end;
end;
assigntype: begin
outExpr(what);
if aval <> nil then
begin
put5(' := ',4);
outExpr(aval);
end;
end;
signaltype,
waittype: begin
if stype = signaltype then put10('signal ',7)
else put5('wait ',5);
outExpr(event);
end;
enabletype,
disabletype: begin
if stype = enabletype then put10('enable ',7)
else put10('disable ',8);
if cmonlab <> nil then
with cmonlab↑.name↑ do putStrng(length,name);
end;
affixtype: begin
put10('affix ',6);
outExpr(frame1);
put5(' to ',4);
outExpr(frame2);
if rigid then put10(' rigidly ',8)
else begin put10(' nonrigidl',10); putchar('y') end;
if byvar <> nil then begin put5(' by ',4); outExpr(byvar) end;
if atexp <> nil then
begin
if (not setup) and (lbufp + getExprLength(atexp) > 75) then
begin
newline(indent+1);
if setCursor and (curLine = cursorLine) then fieldNum := 5;
end;
put5(' at ',4);
outExpr(atexp);
if setup and (lbufp > 79) then curLine := curLine + 1;
end;
end;
unfixtype: begin
put10('unfix ',6);
outExpr(frame1);
put10(' from ',6);
outExpr(frame2);
end;
stoptype: begin
put5('stop ',5);
if cf <> nil then outExpr(cf);
end;
retrytype: put5('retry',5);
requiretype: begin
put10('require ',8);
if rfil then begin put10('source_fil',10); put5('e " ',3) end
else begin put10('error_mode',10); put5('s " ',3) end;
putstrng(rfilen,rfils);
putchar('"');
end;
commenttype: putStrng(len,str);
definetype: begin
put10('define ',7);
with macname↑.name↑ do putStrng(length,name);
if mpars <> nil then (* need to print macro args *)
begin
v := mpars;
putchar('(');
while v <> nil do
begin
with v↑.name↑ do putStrng(length,name);
v := v↑.next;
if v <> nil then putchar(',')
else putchar(')');
end;
end;
put5(' = \ ',4);
putTlist(macdef);
putchar('\');
end;
dimdeftype: begin
put10('dimension ',10);
with dimname↑.name↑ do putStrng(length,name);
put5(' = ',3);
outExpr(dimexpr);
end;
setbasetype: begin
put10('setbase ',8);
if cf <> nil then outExpr(cf);
end;
wristtype: begin
put10('wrist( ',6);
outExpr(fvec);
putchar(',');
outExpr(tvec);
putchar(')');
if ff <> nil then
begin
put10(' about ',7);
outExpr(ff);
end;
if ff <> arm then (* i.e. (arm <> nil) and (ff <> nil) *)
if csys then put10(' in world ',9)
else put10(' in hand ',8);
if arm <> nil then
begin
put5(' of ',4);
outExpr(arm);
end;
end;
armmagictype: begin
put10('arm_magic ',10);
outExpr(cmdnum);
put5(', ',2);
outExpr(dev);
n := iargs;
for i := 1 to 2 do
begin (* print out both arg lists *)
put5(', ( ',3);
while n <> nil do
begin
outExpr(n↑.lval);
n := n↑.next;
if n <> nil then putChar(',');
end;
putChar(')');
n := oargs;
end;
end;
emptytype: begin
put10('/* stateme',10); put5('nt */',5);
end;
(* more??? *)
otherwise begin put10('Oh no! 3 ',10); put10('Bad ovlay!',10); end;
end;
end;